00100	C**** NEWMRK.F4 *****
00200	COPYRIGHT 1982 BY LELAND SMITH
00300	C************ READX, NEWMRK, ISNUM, DOIT, MORMRK, DASHES, CPYALL, CMDIN  *******
00400	
00500		SUBROUTINE READX
00600		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /ALF/INP(72)/SCM/V(78)
00700		EQUIVALENCE (V(2),V2)
00800	C****320	REREAD 2430,J,R2,RJQ
00900	C  ↑↑↑ 1/78
01000		DO 2 K=2,72
01100		IF(INP(K).NE.'<')GO TO 2
01200		DO 3 J=K,72
01300	3	INP(J)=' '
01400		GO TO 4
01500	2	CONTINUE
01600	C CATCH '<' -- WHICH = COMMENT FOR REST OF LINE
01700	4	CALL RREAD(INP,V)
01800		JA=V(1)
01900		R2=V2
02000		DO 1 K=1,20
02100	1	RJQ(K)=V(K+2)
02200		END
02300	
02400		FUNCTION ISNUM(M)
02500	C ISNUM=0 IF M=A NUMBER.  ASSUMES A DOT MEANS DECIMAL POINT
02600		ISNUM=-1
02700		IF(M.EQ.'.')ISNUM=0
02800		IF(M.GE.'0'.AND.M.LE.'9')ISNUM=0 
02900		END
03000	
03100		SUBROUTINE NEWMRK(VX)
03200		DIMENSION VX(1)
03300		COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
03400		1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
03500		DO 40 J=1,72
03600		M=INP(J)
03700	C CHANGES /C 7 12/ TO /C 7:12/  ETC.
03800		IF(M.EQ.'*')GO TO 41
03900		IF(M.NE.'C'.AND.M.NE.'O')GO TO 40
04000		IF(INP(J+1).EQ.'R')GO TO 40
04100		NN=-1
04200		N2=J+1
04300	44	  DO 42 MM=N2,72
04400		  JJ=INP(MM)
04500		  IF(JJ.EQ.'/')GO TO 40
04600		  IF(JJ.EQ.'*'.OR.JJ.EQ.';')GO TO 41
04700		  IF(ISNUM(JJ).NE.0)GO TO 42
04800	C NOW FOUND A NUMBER. NEXT LOOK FOR SPACE.
04900		    DO 43 MX=MM+1,72
04950		    JJ=INP(MX)
04975		    IF(JJ.EQ.'/')GO TO 40
05000		    IF(JJ.NE.' '.AND.JJ.NE.':')GO TO 43
05100		    IF(NN.LT.0)INP(MX)=':'
05200	C INSERT : AFTER EVERY OTHER NUMBER.
05300		    NN=-NN
05400		    N2=MX+1
05500		    GO TO 44
05600	43	    CONTINUE
05700	42	  CONTINUE
05800	40	CONTINUE
05900	41	J=1
06000	34	J=J+1
06100	35	IF(ISNUM(INP(J)).NE.0)GO TO 30
06200			DO 31 MM=J+1,72
06300			M=INP(MM)
06400			IF(M.EQ.'/')GO TO 30
06500			IF(M.EQ.';')GO TO 30
06600			IF(M.EQ.'*')GO TO 30
06700			IF(M.NE.' ')GO TO 31
06800	C NOW FOUND SPACE AFTER NUMB.
06900				DO 32 J=MM+1,72
07000				M=INP(J)
07100				IF(M.EQ.' ')GO TO 32
07200				IF(ISNUM(M).NE.0)GO TO 30
07300	C FOUND SOMETHING, BUT NOT NUMB.
07400				INP(MM)=','
07500	C  FOUND NUMB, SO PUT IN COMMA
07600			
07700				IF(J.LT.72)GO TO 35
07800				GO TO 33
07900	32			CONTINUE
08000			GO TO 33
08100	31		CONTINUE
08200		GO TO 33
08300	30	IF(J.LT.72)GO TO 34
08400	33	MX=0
08500	C MX IS FLAG FOR LINE TOO LONG IN NEW FORMAT
08600		J=0
08700		MM=0
08800	10	JJ=0
08900		NN=0
09000		N2=0
09100	1	J=J+1
09200		IF(J.GT.72)GO TO 20
09300	C JUMP IF DONE
09400		M=INP(J)
09500	CURRENT CHARACTER
09600		IF(M.EQ.'-')GO TO 21
09700	C  '-' NEEDED FOR "C-" (DECRESC. SIGN)
09800		IF(M.LT.'A'.OR.M.GT.'Z')GO TO 2
09900	C JUMP IF A LETTER IS NOT FOUND
10000	21	JJ=JJ+1
10100		N(JJ)=M
10200		GO TO 1
10300	2	IF(M.EQ.' ')GO TO 1
10400	5	NN=NN+1
10500		JN(NN)=M
10600	C SAVE THE NUMBER CHARS.
10700	6	J=J+1
10800		M=INP(J)
10900	CC	IF(M.GE.'0'.AND.M.LE.'9')GO TO 5
11000	CC	IF(M.EQ.'.')GO TO 5
11100		IF(ISNUM(M).EQ.0)GO TO 5
11200	CXX	IF(M.NE.':')GO TO 22
11300		IF(M.NE.'!')GO TO 22
11400		M='-'
11500	C NEG. N2 WILL =TOTAL OF ITEMS STARTING WITH N1( /S 12!3/=/S 12:14/)
11600		NN=NN+1
11700		JN(NN)=' '
11800		GO TO 5
11900	22	IF(M.EQ.' ')GO TO 6
12000		IF(M.NE.':')GO TO 7
12100	C NOW A SEQUENCE OF ITEMS
12200		M=' '
12300		GO TO 5
12400	7	IF(M.NE.',')GO TO 8
12500	C NOW A SINGLE ITEM
12600		CALL DOIT
12700		NN=0
12800	C ITEM OR ITEMS NOW FINISHED
12900		GO TO 6
13000	8	IF(M.NE.'/')GO TO 11
13100		CALL DOIT
13200		GO TO 10
13300	11	IF(M.NE.';'.AND.M.NE.'*')GO TO 6
13400	C JUMP IF UNKNOWN CHAR.
13500		CALL DOIT
13600		KN(MM)=M
13700		IF(MM.LE.71)GO TO 20
13800	C SKIP IF REVISED LINE NOT TOO LONG
13900		MZ=MM
14000		DO 201 MM=71,1,-1
14100	201	IF(KN(MM).EQ.'/')GO TO 202
14200	202	MX=MM+1
14300	C POINTS TO START OF REMAINDER OF TOO-LONG LINE
14400		INP(72)=0
14500	20	CALL MORMRK(1,MM,VX)
14600		END
14700	
14800		SUBROUTINE DOIT
14900		COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
15000		IF(N(1).NE.'C'.AND.N(1).NE.'O')GO TO 3
15100	CATCHES /C 5-7/C- 11.2-13.5/O 1-21/  ETC.
15200		IF(N2.EQ.'R')GO TO 3
15300	C JUMP IF "CR"  FOR WORD "CRESC."
15400		DO 4 K=1,NN
15500		MM=MM+1
15600		JX=JN(K)
15700		KN(MM)=JX
15800	4	IF(JX.EQ.' ')GO TO 5
15900	C  FIRST NUMBER COMPLETED
16000	5	DO 6 JX=1,JJ
16100		MM=MM+1
16200	6	KN(MM)=N(JX)
16300	CODE LETTER INSERTED
16400		MM=MM+1
16500		KN(MM)=' '
16600		DO 7 JX=K+1,NN
16700	C NOW PUT IN LAST NUMBER
16800		MM=MM+1
16900	7	KN(MM)=JN(JX)
17000		GO TO 8
17100	3	DO 1 K=1,NN
17200		MM=MM+1
17300	1	KN(MM)=JN(K)
17400		MM=MM+1
17500		KN(MM)=' '
17600		DO 2 K=1,JJ
17700		MM=MM+1
17800	2	KN(MM)=N(K)
17900	C NOW PUT IN THE CODE WORD
18000	8	MM=MM+1
18100		KN(MM)='/'
18200	CLOSE OFF THE ITEM
18300		END
18400	
18500	CC	SUBROUTINE MORMRK(VX)
18600		SUBROUTINE MORMRK(MA,MB,VX)
18700		DIMENSION VX(1)
18800		COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JO,NN,MM
18900		1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
19000	CC	K=0
19100		MM=0
19200	C GET THE REST OF A TOO-LONG LINE
19300		DO 1 K=MA,MB
19400	CC	DO 1 J=MX,MZ
19500		MM=MM+1
19600	CC	K=K+1
19700	1	INP(MM)=KN(K)
19800	CC1	INP(K)=KN(J)
19900	CC	MM=K
20000		DO 13 K=MM+1,72
20100	13	INP(K)=' '
20200		IF(INP(MM).EQ.'*')INP(72)='*'
20300	C LINE ENDS WITH * OR ;
20400	C NOW GO FIX UP THE VX ARRAY.
20500	3	CALL RREAD(INP,VX)
20600		DO 23 K=1,50
20700		X=VX(K)
20800		IF(X.GT.0)Z=X
20900	C SAVE THE LAST POSITIVE NUM.
21000		IF(X.LT.0)VX(K)=-X+Z-1.
21100	C /S 17:5/=/S 17-21/ I.E. 5 NOTES STACCATO, STARTING WITH 17
21200	23	CONTINUE
21300	999	NNN=VX(1)
21400	CC	MX=0
21500		END
21600	 
21700		SUBROUTINE DASHES(IX,R2,RD)
21800	CC	SUBROUTINE DASHES(IX,R2,R3,R4,R5,R6)
21900		DIMENSION RD(1)
22000	C R3=RD(1) R4=RD(2) . . . R7=RD(5)  R8=RD(6) . . .
22100	      COMMON /XRN/RN(3000)/PTR/KWDS(350)/DL/K22 /STF/RSTFAC(0/7),RSTJ2
22200		DATA RDX/2.3/,RDZ/0.5/,BSIZE/3.17/
22300	C FIND CLOSEST WORD TO LFT AND RIGHT OF R3    BSIZE=BASIC SIZE OF 1 LETTER
22400		IF(RD(8).EQ.0)RETURN
22500	C P10 MUST NOT!! BE ZERO.
22600		B=9999.0
22700		A=-B
22800		LFT=0
22900		JRT=0
23000		DO 1 K=1,IX
23100	C GETS CODE NUM. J=PTR TO THAT ITEM.
23200		J=KWDS(K)
23300	5	IF(RN(J+1).NE.16)GO TO 1
23400	C FOUND WORD
23500		IF(RN(J+2).NE.R2)GO TO 1
23600	C NOW ON THIS STAFF
23700		IF(ABS(RN(J+4)-RD(2)).GT.4.)GO TO 1
23800	C  P4 OF DASH MUST BE WITHIN +4, -4 VERTICAL STEPS OF WORD ON EITHER SIDE.
23900	7	RR3=RN(J+3)
24000		IF(RR3.GT.RD(1))GO TO 3
24100		IF(RR3.LE.A)GO TO 1
24200		A=RR3
24300		LFT=J
24400	C A WILL BE POS. OF FRONT OF LEFT GROUP.  LFT IS PNTR.
24500		GO TO 1
24600	3	IF(RR3.GE.B)GO TO 1
24700		B=RR3
24800		JRT=J
24900	1	CONTINUE
25000	C WON'T WORK WITH OVERLAPPING WORDS!!!!
25100	
25200		J=LFT
25300		IF(LFT.NE.0)GO TO 2
25400		IF(JRT.EQ.0)RETURN
25500		J=JRT
25600	2	SZ=RN(J+5)
25700		R5=SZ*RSTJ2
25800	C R=REAL SIZE FACTOR FOR SPACE     RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
25900		RP=R5*RN(J+9)+A
26000		IF(RP.LT.0)RP=3.0
26100	C RP=RIGHT SIDE OF LEFT CHAR. STRING.
26200		R3=RP
26300		IF(B.GT.201)B=201.
26400		R6=B-R5*BSIZE
26500	CC	RR6=R6
26600		IF(R3.LT.0)R3=4.
26700	CX	IF(R6.GT.201)R6=201.
26800	C 3.17 IS BASIC WIDTH OF MOST LETTERS
26900		IF(RD(5).EQ.0)GO TO 4
27000	C SKIP IF R7=0 (NO SHORT DASHES)
27100		A=B-RP-BSIZE*R5
27200	C DIST. FROM END OF LFT WD TO START OF RT WD. (LESS 2 CHAR SPACES)
27300	8	B=IFIX(A/(25.*R5))+1.
27400	C  B=NUMB OF DASHES
27500	9	RR3=2.5*SZ
27600	C RR3 IS DASH WIDTH
27700		A=(A-B*2.5*R5)/(B+1.)
27800	C A=SPACE BETWEEN DASHES  (P9)  IF SPACE IS TOO SMALL MAKE LRG DASH.
27900	CCC	IF(A.LT.RDZ)GO TO 11
28000		R3=RP+A
28100	10	R6=R6-RDZ
28200	CC10	R6=R3+(RR3+A)*B-RR3-RDZ
28300		RD(6)=RR3
28400		RD(7)=A/RSTJ2
28500	C P9(SPACE BETWEEN DASHES) REAL SIZE IS P9*RSTJ2
28600	CCC	GO TO 4
28700	CCC11	RD(5)=0
28800	4	RD(2)=RN(J+4)+1.0-R5*0.5
28900	C  SET HEIGHT OF DASH   CONSIDERS LETTER SIZE AND STAFF SIZE
29000		RD(3)=RD(2)
29100	C WAS R5=R4
29200		RD(1)=R3
29300		IF(R6-R3.LT.0.2)R6=R3+0.2
29400		RD(4)=R6
29500		END
29600	
29700		SUBROUTINE CPYALL
29800	C COPIES ALL OF ONE CODE NUM. FROM ONE STAFF TO ALL OTHER ACTIVE STAVES.
29900		COMMON  /LIMIT/LIMIT,ITEM,L,I /PTR/KWDS(1) /POSI/S(8),JJ2
30000		COMMON R2,J,K,N,RJQ(3),R6,RJ(16),NO,JQ(10),NN,LL  /XRN/RN(1) 
30100		JJ2=ITEM+1
30200		J=ITEM
30300	C NOW FIND WHICH STAVES CURRENTLY ACTIVE
30400		DO 1 K=0,7
30500	1	JQ(K)=0
30600		DO 2 K=1,J
30700		L=KWDS(K)
30800	2	JQ(IFIX(RN(L+2)))=-1
30900		JQ(IFIX(R2))=0
31000	C BUT OMIT SOURCE STAFF
31100		DO 3 K=1,J
31200		L=KWDS(K)
31300		IF(RTLINE(L).LT.0)GO TO 3
31400	C ON RIGHT LINE?
31500		IF(OUTLIM(L,3).LT.0)GO TO 3
31600	C  WITHIN GIVEN LFT AND RT LIMITS?
31700	9	IF(RN(L+1).NE.R6)GO TO 3
31800	C FOUND A SOURCE ITEM (CODE# IN R11).  NOW PUT IT ON ALL OTHER STAVES.
31900	7	NN=RN(L)+3
32000	C NUMBER OF NEW WORDS ADDED TO ARRAY
32100		DO 8 N=0,7
32200		IF(JQ(N).EQ.0)GO TO 8
32300	4	CALL LOOP(0,NN,1,I,L,RN)
32400	5	ITEM=ITEM+1
32500		LL=KWDS(ITEM)
32600		RN(LL+2)=N
32700	C PUT IN CORRECT STAFF NUM.
32800	6	I=I+NN
32900	C UPDATE XRN ARRAY COUNTER AND POINTER ARRAY.
33000		KWDS(ITEM+1)=I
33100	8	CONTINUE
33200	3	CONTINUE
33300	CC	JJ2=ITEM+1
33400		END
33500	
33600		SUBROUTINE CMDIN
33700	C SAVES INPUT LINES WHEN 1ST CHAR. IS :    EACH STRING=23 CHARS.
33800	C OUTPUTS SAVED LINES WHEN 1ST CHAR. IS ;
33900		COMMON /ALF/INP(72)
34000		DIMENSION J(72)
34100		EQUIVALENCE (I1,INP),(I2,INP(2)),(I3,INP(3))
34200		IF(I1.EQ.';')GO TO 11
34300	C JUMP TO GET BACK COMMAND 1, 2 OR 3 (; ;; ;;;)
34400	   	N=2
34500		L=1
34600		LL=1
34700	10	NN=N+22
34800		DO 2 K=N,NN
34900		M=INP(K)
35000		IF(M.EQ.':')GO TO 3
35100		J(L)=M
35200	2	L=L+1
35300		IF(K.EQ.NN)GO TO 6
35400	3	DO 5 KK=K,NN
35500		J(L)=' '
35600	5	L=L+1
35700	4	IF(M.NE.':')GO TO 6
35800	C 3 COMMANDS CAN BE GIVEN ON ONE LINE, EACH STARTS WITH :
35900	C  THE 1ST ONE WILL BE ACTIVATED IMMEDIATELY, OR BY TYPING ;
36000	C THE 2ND AND 3RD ARE ACTIVATED BY TYPING ;; OR ;;;
36100	C NO ERROR TRAP FOR MORE THEN 3 COLONS
36200		LL=LL+23
36300		L=LL
36400		N=K+1
36500		GO TO 10
36600	6	N=1
36700	9	NN=N+19
36800		L=0
36900		DO 7 K=N,NN
37000		L=L+1
37100	7	INP(L)=J(K)
37200		DO 8 K=24,72
37300	C CLEAR REST OF INP ARRAY
37400	8	INP(K)=' '
37500		RETURN
37600	11	N=1
37700		IF(I2.EQ.';')N=24
37800		IF(I3.EQ.';')N=47
37900		GO TO 9
38000	C  GO GET BACK COMMAND 1, 2 OR 3  (; ;; ;;;)
38100		END